home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / exampl2r / form_tas.ctl next >
Text File  |  1999-07-10  |  9KB  |  331 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Form_TaskBar 
  3.    BackColor       =   &H00FF0000&
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   3525
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   1470
  9.    Enabled         =   0   'False
  10.    ForwardFocus    =   -1  'True
  11.    InvisibleAtRuntime=   -1  'True
  12.    ScaleHeight     =   3525
  13.    ScaleWidth      =   1470
  14.    Windowless      =   -1  'True
  15.    Begin VB.Timer tmrDelayedInit 
  16.       Left            =   120
  17.       Top             =   360
  18.    End
  19.    Begin VB.Timer tmrCheckMouseOver 
  20.       Left            =   120
  21.       Top             =   1800
  22.    End
  23.    Begin VB.Timer tmrAppFocus 
  24.       Left            =   120
  25.       Top             =   1320
  26.    End
  27.    Begin VB.Timer tmrSliding 
  28.       Left            =   120
  29.       Top             =   840
  30.    End
  31.    Begin VB.Label Label1 
  32.       BackStyle       =   0  'Transparent
  33.       Caption         =   "TaskBar"
  34.       ForeColor       =   &H00FFFFFF&
  35.       Height          =   495
  36.       Left            =   0
  37.       TabIndex        =   0
  38.       Top             =   0
  39.       Width           =   855
  40.    End
  41. End
  42. Attribute VB_Name = "Form_TaskBar"
  43. Attribute VB_GlobalNameSpace = False
  44. Attribute VB_Creatable = True
  45. Attribute VB_PredeclaredId = False
  46. Attribute VB_Exposed = False
  47. Option Explicit
  48.  
  49. ' Problems:
  50. '   "runs" while in IDE
  51. '   can't be moved to the left, right, bottom, etc...
  52. '   can't be positioned other than centered
  53. '   when it moves down, it's kinda slow
  54. '   the whole thing has too many hacks involving timers
  55.  
  56. ' ########### API Calls #############
  57. Private Type RECT
  58.     x1 As Long
  59.     y1 As Long
  60.     x2 As Long
  61.     y2 As Long
  62. End Type
  63. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  64. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, rectangle As RECT) As Long
  65. '
  66. Private Const SWP_NOMOVE = 2
  67. Private Const SWP_NOSIZE = 1
  68. Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  69. Private Const HWND_TOPMOST = -1
  70. Private Const HWND_NOTOPMOST = -2
  71. Private Declare Function SetWindowPos Lib "user32" _
  72.             (ByVal hwnd As Long, _
  73.             ByVal hWndInsertAfter As Long, _
  74.             ByVal X As Long, _
  75.             ByVal Y As Long, _
  76.             ByVal cx As Long, _
  77.             ByVal cy As Long, _
  78.             ByVal wFlags As Long) As Long
  79. '
  80. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  81. Private Type POINTAPI
  82.         X As Long
  83.         Y As Long
  84. End Type
  85. '
  86. Private Declare Function GetForegroundWindow Lib "user32" () As Long
  87.  
  88.  
  89. ' ######### Events ###########
  90. Event AppGotFocus()
  91. Event AppLostFocus()
  92. Event EndOpenUp()
  93. Event EndCloseUp()
  94. Event StartOpenUp()
  95. Event StartCloseUp()
  96. Event ChangeCloseUp()
  97. Event ChangeOpenUp()
  98. Event MouseOver()
  99. Event MouseLeft()
  100.  
  101. ' ########## Member Vars #######
  102. Private mbActivated As Boolean
  103.  
  104. Private miScreenWidth As Integer
  105. Private miScreenHeight As Integer
  106. Private moForm As Form
  107.  
  108. Private mbSliderOut As Boolean
  109. Private miSliderHowFar As Integer
  110. Private miSliderChanging As Integer
  111. Private mbHaveFocus As Boolean
  112. Private mbMouseOver As Boolean
  113.  
  114. 'Default Property Values:
  115. Const m_def_NumSteps = 4
  116. Const m_def_HangDown = 2
  117. 'Property Variables:
  118. Dim m_NumSteps As Integer
  119. Dim m_HangDown As Integer
  120. 'Event Declarations:
  121.  
  122.  
  123.  
  124.  
  125. Private Sub UserControl_Initialize()
  126.     tmrDelayedInit.Enabled = True
  127.     tmrDelayedInit.Interval = 1
  128. End Sub
  129.  
  130. Private Sub tmrDelayedInit_Timer()
  131.     On Error GoTo NoForm
  132.     Set moForm = UserControl.Parent
  133.     On Error GoTo 0
  134.     
  135.     Call GetScreenResolution
  136.     
  137.     Call moForm.Move((miScreenWidth - moForm.Width) / 2, _
  138.                 m_HangDown * Screen.TwipsPerPixelY - moForm.Height)
  139.                 
  140.     Call SetTopMost(moForm.hwnd)
  141.     
  142.     mbActivated = True
  143.     
  144.     tmrCheckMouseOver.Enabled = True
  145.     tmrCheckMouseOver.Interval = 200
  146.     
  147.     tmrAppFocus.Enabled = True
  148.     tmrAppFocus.Interval = 200
  149.     
  150.     tmrDelayedInit.Enabled = False
  151.     
  152.     Exit Sub
  153.     
  154. NoForm:
  155.     MsgBox Err.Description, vbMsgBoxHelpButton, , Err.HelpFile, Err.HelpContext
  156.     mbActivated = False
  157.     
  158.     tmrDelayedInit.Enabled = False
  159. End Sub
  160.  
  161. Private Sub GetScreenResolution()
  162.     Dim r As RECT
  163.     Call GetWindowRect(GetDesktopWindow(), r)
  164.     
  165.     miScreenWidth = (r.x2 - r.x1) * Screen.TwipsPerPixelX
  166.     miScreenHeight = (r.y2 - r.y1) * Screen.TwipsPerPixelY
  167. End Sub
  168.  
  169. Private Sub SetTopMost(hwnd As Integer)
  170.     Call SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  171. End Sub
  172.  
  173. Private Sub SetSliderOut(bSO As Boolean)
  174.     tmrSliding.Interval = 1
  175.     
  176.     If (bSO) Then           ' We're opening up
  177.         If (mbSliderOut = False) Then
  178.             RaiseEvent StartOpenUp
  179.         ElseIf (miSliderChanging < 0) Then
  180.             RaiseEvent ChangeOpenUp
  181.         End If
  182.             
  183.         miSliderChanging = moForm.Height / m_NumSteps
  184.         tmrSliding.Enabled = True
  185.     Else                    ' We're closing up
  186.         If (mbSliderOut = True) Then
  187.             RaiseEvent StartCloseUp
  188.         ElseIf (miSliderChanging > 0) Then
  189.             RaiseEvent ChangeCloseUp
  190.         End If
  191.         
  192.         miSliderChanging = -moForm.Height / m_NumSteps
  193.         tmrSliding.Enabled = True
  194.     End If
  195. End Sub
  196.  
  197. Private Sub tmrSliding_Timer()
  198.     Dim iToBeTop As Integer
  199.  
  200.     iToBeTop = moForm.Top + miSliderChanging
  201.  
  202.     If (iToBeTop >= 0) Then
  203.         Call moForm.Move(moForm.Left, 0)
  204.         mbSliderOut = True
  205.  
  206.         miSliderChanging = 0
  207.         tmrSliding.Enabled = False
  208.  
  209.         RaiseEvent EndOpenUp
  210.  
  211.         Exit Sub
  212.     ElseIf (iToBeTop <= m_HangDown * Screen.TwipsPerPixelY - moForm.Height) Then
  213.         Call moForm.Move(moForm.Left, m_HangDown * Screen.TwipsPerPixelY - moForm.Height)
  214.         mbSliderOut = False
  215.  
  216.         miSliderChanging = 0
  217.         tmrSliding.Enabled = False
  218.  
  219.         RaiseEvent EndCloseUp
  220.  
  221.         Exit Sub
  222.     End If
  223.  
  224.     Call moForm.Move(moForm.Left, iToBeTop)
  225. End Sub
  226.  
  227. Private Sub tmrCheckMouseOver_Timer()
  228.     Dim bThisMouseOver As Boolean
  229.     
  230.     Dim p As POINTAPI
  231.     Call GetCursorPos(p)
  232.     
  233.     ' Check the screen coordinates of our window.  If it's not in ours, close ourselves up.
  234.     Dim r As RECT
  235.     Call GetWindowRect(moForm.hwnd, r)
  236.     bThisMouseOver = (p.X >= r.x1 And p.X <= r.x2 And p.Y >= r.y1 And p.Y <= r.y2)
  237.     If (bThisMouseOver <> mbMouseOver) Then
  238.         mbMouseOver = bThisMouseOver
  239.         
  240.         If (mbMouseOver) Then           ' Just got the mouse over
  241.             RaiseEvent MouseOver
  242.             If (Not mbHaveFocus) Then _
  243.                 Call SetSliderOut(True)
  244.         Else                            ' Just lost mouse over
  245.             RaiseEvent MouseLeft
  246.             If (Not mbHaveFocus) Then _
  247.                 Call SetSliderOut(False)
  248.         End If
  249.     End If
  250. End Sub
  251.  
  252. Private Sub tmrAppFocus_Timer()
  253.     Dim bThisHaveFocus As Boolean
  254.     
  255.     bThisHaveFocus = (GetForegroundWindow() = moForm.hwnd)
  256.     
  257.     ' We've just changed states
  258.     If (bThisHaveFocus <> mbHaveFocus) Then
  259.         mbHaveFocus = bThisHaveFocus
  260.         
  261.         If (mbHaveFocus) Then        ' Got focus
  262.             RaiseEvent AppGotFocus
  263.             Call SetSliderOut(True)
  264.         Else                        ' Lost focus
  265.             RaiseEvent AppLostFocus
  266.             Call SetSliderOut(False)
  267.         End If
  268.     End If
  269. End Sub
  270.  
  271.  
  272. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  273. 'MemberInfo=7,0,0,4
  274. Public Property Get NumSteps() As Integer
  275. Attribute NumSteps.VB_Description = "The number of steps drawn while moving the taskbar down."
  276.     NumSteps = m_NumSteps
  277. End Property
  278.  
  279. Public Property Let NumSteps(ByVal New_NumSteps As Integer)
  280.     m_NumSteps = New_NumSteps
  281.     PropertyChanged "NumSteps"
  282. End Property
  283.  
  284. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  285. 'MemberInfo=7,0,0,2
  286. Public Property Get HangDown() As Integer
  287. Attribute HangDown.VB_Description = "How many pixels will hang down into the screen."
  288.     HangDown = m_HangDown
  289. End Property
  290.  
  291. Public Property Let HangDown(ByVal New_H